home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / fido / shelter191a.lha / rexx / FTNsort.rexx < prev    next >
OS/2 REXX Batch file  |  1994-06-29  |  9KB  |  301 lines
  1. /**/
  2. v="$VER: FTNsort Rexx Multi-FTN Extract and Sort Williamson 50.24"
  3. import_command=""
  4. prodfile='BBSF5:ftsc/ftscprod.048'
  5. /* define your AmigaDOS script here with fullpath name. This will be    */
  6. /* executed as: 'Run >NIL: Execute' import_command domain pktfile       */
  7. /* Your script key arguments should be:                                 */
  8. /*  .key domain/a,file/a                                                */
  9. /*      where domain is the FTN organization name of the file           */
  10. /*      and file is the name of the file                                */
  11. /* your script should be able to build the fullpathname                 */
  12. /* If no command is specified, CYBERCRON will asyncronously execute     */ 
  13. /* InboundMGR.rexx                                                      */
  14. /*
  15.      Some HUBS bundle mail for all ones' addresses in a single archive
  16.      If you know this is case for your HUB, then you can use this utility
  17.      to extract the packets from the archive and sort them by ftn,
  18.      moving them to the proper inbound directory.
  19.      It may also be necessary to use this, after EMSI sessions, if your 
  20.      tosser is not domain or zone aware.
  21.      Written for Guy Smith ;)
  22. */
  23. debug=0
  24. options results
  25. options failat 20
  26. signal on syntax
  27. signal on halt
  28. signal on ioerr
  29. signal on break_c
  30. signal on break_d
  31.  
  32. if ~show("L", "rexxsupport.library") then
  33.     if ~addlib("rexxsupport.library", 0, -30, 0) then do
  34.         PutLog("Couldn't access support.library !",100,10)
  35.         exit 20
  36.     end
  37. pragma("W","NULL")
  38. log=show('P','ROOFLOG')
  39. sv="v"||right(v,5)
  40. script="FTNsort"
  41. dolist=0
  42.  
  43. rpath=GetClip('REXXDIR')||"/"
  44. dl=GetClip('DOMAINLIST')
  45. inroot=GetCLIP('INDIR')"/"
  46. call makedir(inroot||"ftnsort")
  47. sortdir=inroot||"ftnsort/"
  48. tfile="T:FTNS-"Pragma('ID')
  49.  
  50. parse upper arg arcmail indir .
  51. if (~openport('CMPORT')) then do
  52.     call PutLog('Another task has CMPORT',40,90)
  53.     if exists('RPDIR:FTNSORT') then  address "CYBERCRON" "ADD_EVENT" '* * * * * :NAME Sort Run >NIL: FTNSORT 'arcmail indir' :EXECONCE :OBEYQUEUE i'
  54.     else address "CYBERCRON" "ADD_EVENT" '* * * * * :NAME Sort :REXX 'rpath'FTNsort.rexx 'arcmail indir' :EXECONCE :OBEYQUEUE i'
  55.     exit 0
  56. end
  57. if arcmail="" then do
  58.     call PutLog('No file name, exiting',10,10)
  59.     exit 0
  60. end
  61. if arcmail="LIST" then do
  62.     sortlist=indir
  63.     if ~exists(sortlist) then do
  64.         putlog(sortlist' does not exist',10,10)
  65.         exit
  66.     end
  67.     arcmail=""
  68.     indir=""
  69.     dolist=1
  70. end
  71. if arcmail="SCAN" then do
  72.     sortlist="T:scan"||pragma('ID')
  73.     lspec="????????.(PK|MO|TU|WE|TH|FR|SA|SU)[T,0-9]"
  74.     cmd='List >'sortlist addslash(indir)||lspec 'nohead LFORMAT "%S%S"'         
  75.     PutLog('Scanning: 'indir,10,90)
  76.     address COMMAND cmd
  77.     arcmail=""
  78.     dolist=1
  79. end
  80.  
  81. if debug then wspec='CON:0/10/640/100/'script sv'/WAIT/AUTO/SCREEN'||GetClip('ASYNCSCREEN')
  82.     else wspec='CON:0/10/640/100/'script sv'/INACTIVE/AUTO/SCREEN'||GetClip('ASYNCSCREEN')
  83. call close('STDOUT');call open('STDOUT',wspec,'w')
  84. call close('STDIN');call open('STDIN','*','R')
  85.  
  86. if dolist=0 then call sortarc()
  87. else do
  88.     call putLog('Sorting mail list' sortlist,10,10)
  89.     x=open('list',sortlist,'r') 
  90.     if x=0 then do
  91.         call PutLog('Cannot find 'sortlist,10,10)
  92.         exit
  93.     end
  94.     do while ~eof('list')
  95.         arcmail=readln('list')
  96.         if arcmail="" then iterate
  97.         if exists(arcmail) then call sortarc()
  98.             else call PutLog(arcmail' does not exist',10,10)
  99.     end
  100.     call close('list')
  101.     call delete(sortlist)
  102. end
  103. exit
  104.  
  105. sortarc:
  106.     if indir="" | indir="INDIR" then do
  107.         if index(arcmail,":")>0 | index(arcmail,"/")>0 then do
  108.             indir=get_path(arcmail)
  109.             arcmail=get_fn(arcmail)
  110.         end;else do
  111.             indir=inroot||"NONSECURE/"
  112.         end
  113.     end;else do
  114.         indir=addslash(indir)
  115.         arcmail=get_fn(arcmail)
  116.     end
  117.     call Pragma('D',sortdir)
  118.     fnote=subword(statef(indir||arcmail),8)
  119.  
  120.     PutLog('Processing:'indir||arcmail fnote,10,10)
  121.  
  122.     if right(upper(arcmail),4)='.PKT' then do
  123.         ispacket=1
  124.         PutLog('Moving 'arcmail' to 'sortdir,10,10)
  125.         if ~rename(indir||arcmail,sortdir||arcmail) then do
  126.             PutLog('Move 'indir||arcmail' to 'sortdir||arcmail' failed',10,10)
  127.             return
  128.         end
  129.     end;else do
  130.         ispacket=0
  131.         if exists('RPDIR:X') then address COMMAND "X" indir||arcmail "*.PKT"
  132.         else address "REXX" rpath'X.rexx' indir||arcmail
  133.         if RC ~= 0 then do
  134.             PutLog('Extract of 'indir||arcmail' failed',10,10)
  135.             return
  136.         end
  137.     end
  138.     /* get list of packets */
  139.     pktlist=showdir(sortdir,"F")
  140.     if words(pktlist)=0 then do
  141.         PutLog('Found no packets in' sortdir,10,10)
  142.         return
  143.     end;else do
  144.         PutLog('Found mail packets in' sortdir,10,10)
  145.         err=0
  146.         /* examine each packet */
  147.         do i=1 to words(pktlist)
  148.             moveit=0
  149.             pktfile=word(pktlist,i)
  150.             pktmail=sortdir||pktfile
  151.             if word(statef(pktmail),2) ~= '0' then do
  152.                 domain=readpkt(pktmail)
  153.                 if domain=0 then err=err+1
  154.                 else do
  155.                     destdir=addslash(inroot||domain)
  156.                     moveit=1
  157.                 end
  158.             end
  159.             if ~moveit then iterate
  160.             if ~rename(pktmail,destdir||pktfile) then do
  161.                 call PutLog('Rename of 'pktmail 'to' destdir||pktfile' failed',10,10)
  162.                 err=err+1
  163.             end;else do
  164.                 Address COMMAND "FileNote" destdir||pktfile '"'fnote'"'
  165.                 PutLog('Requesting import of 'destdir||pktfile,10,10)
  166.                 if import_command="" then do
  167.                     Address CYBERCRON 'ADD_EVENT * * * * * :REXX Ram:rexx/InboundMGR.rexx TOSSPKT 'domain pktfile' :EXECONCE :OBEYQUEUE i'
  168.                 end;else do
  169.                     Address COMMAND "Run >NIL: Execute" import_command domain pktfile
  170.                 end
  171.             end
  172.         end
  173.     end
  174.     if ispacket=0 then do
  175.         if err=0 then do
  176.             PutLog('Deleting 'indir||arcmail,10,10)
  177.             call delete(indir||arcmail)
  178.         end;else do
  179.             PutLog('Had 'err' errors, renaming 'indir||arcmail' to 'indir||arcmail||'.BAD',10,10)
  180.             call rename(indir||arcmail,indir||arcmail||'.BAD')
  181.         end
  182.     end
  183. return 0
  184.  
  185.  
  186. /* read a packet and get destination address and domain */
  187. readpkt:
  188.     packet=arg(1)
  189.     if ~open('pkt',packet,'R') then do
  190.         PutLog("Can't open "packet,10,10)
  191.         err=err+1
  192.         return 0
  193.     end
  194.     buffer=readch('pkt',58)
  195.     call close('pkt')
  196.  
  197.     ozone=getint(46)
  198.     if ozone=0 | ozone=256 then ozone=getint(34)
  199.     dzone=Getint(48)
  200.     if dzone=0 | dzone=256 then dzone=getint(36)
  201.  
  202.     if ozone=0 | ozone=256 | dzone=0 | dzone=256 then do
  203.         PutLog("ERR: Can't find domain, zone undefined in "packet,10,10)
  204.         err=err+1
  205.         drop buffer packet
  206.         return 0
  207.     end
  208.     oaddress=ozone":"getint(20)"/"getint(0)"."getint(50)
  209.     daddress=dzone":"getint(22)"/"getint(2)"."getint(52)
  210.     PutLog('Packet 'packet' from 'oaddress' for 'daddress,10,10)
  211.  
  212.     odomain=find_domain(ozone)
  213.     ddomain=find_domain(dzone)
  214.     PutLog('Origin Domain:'odomain', Destination Domain:'ddomain,10,10)
  215.  
  216.     pch=GetByte(42)
  217.     pcl=GetByte(24)
  218.     pc=d2x(pcl)
  219.     pver='v'||GetByte(25)'.'GetByte(43)
  220.     drop buffer packet
  221.     found=0
  222.     if open('x',prodfile,'r') then do
  223.         do while ~found | ~eof('x')
  224.             q=readln('x')
  225.             if left(q,length(pc))=pc then do
  226.                 found=1
  227.                 parse var q qa ',' name ',' qa ',' type ',' qa ',' qa
  228.             end
  229.         end
  230.         call close('x')
  231.     end
  232.     if found then call PutLog('Product:'name '('pc')' type pver' from 'oaddress,10,10)
  233.           else call PutLog('Product:'pch pcl '('pc')' pver' from 'oaddress,10,10)
  234. return ddomain
  235.  
  236. getint:
  237.     return c2d('00'x||reverse(substr(buffer,arg(1)+1,2)))
  238. getint2:
  239.     return right('00'||c2d('00'x||reverse(substr(buffer,arg(1)+1,2))),2)
  240. getbyte:
  241.     return c2d('00'x||substr(buffer,arg(1)+1,1)) 
  242.  
  243. PutLog:  procedure expose log script
  244.     if arg(3) < GetClip('STATUSLEVEL') then say arg(1)
  245.     if arg(2) > GetClip('LOGLEVEL') then return 0
  246.     if log then address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  247. return 0
  248.  
  249. cleanup:
  250.     PutLog('Exiting',10,10)
  251.     if exists(tfile) then call delete(tfile)
  252. return 0
  253.  
  254.  
  255. addslash:
  256. curr=arg(1)
  257. select
  258.     when right(curr, 1)=":" then nop
  259.     when right(curr, 1)="/" then nop
  260.     otherwise curr=curr"/"
  261. end
  262. return(curr)
  263.  
  264. get_path:
  265. pos=LastPos('/',arg(1))
  266. if pos=0 then pos=LastPos(':',arg(1))
  267. return SubStr(arg(1),1,pos)
  268.  
  269. get_fn:
  270. if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  271. else if LastPos(':',arg(1))~=0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
  272. else return arg(1)
  273.  
  274. /*  Error handling */
  275. break_c:
  276. break_d:
  277.     call cleanup
  278.     exit 10
  279. novalue:
  280.     call template_oops "Novalue" sigl
  281. syntax:
  282.     call template_oops "Syntax(RC="||RC||")" sigl RC
  283. failure:
  284.     call template_oops "Failure(RC="||RC||")" sigl
  285. ioerr:
  286.     call template_oops "IOErr" sigl 
  287. halt:
  288.     call template_oops "Halt" sigl 
  289. template_oops: procedure
  290.     parse arg what badline code
  291.     if code ~= "" then call PutLog("ERR: Line" badline what errortext(code),10,10)
  292.     else call PutLog("ERR: Line "badline what,10,10)
  293.     call cleanup
  294.     exit(40)
  295. /**/
  296.  
  297. find_domain: procedure expose dl
  298. dz=FIND(dl,arg(1))
  299. if dz=0 then return 0
  300. else return strip(word(dl,dz-1))
  301.